home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qwik30.arc / QINITEST.PAS < prev    next >
Pascal/Delphi Source File  |  1987-08-31  |  3KB  |  97 lines
  1. { Qinitest.pas - tests your system configuration            ver 3.0, 08-31-87 }
  2.  
  3. {$i qwik30.inc}
  4.  
  5. var
  6.   CursorMode: integer absolute $0040:$0060;
  7.   Tattr:      byte    absolute  Dseg:$0008;
  8.   CRTcols:    byte;
  9.   i,OldVmode: integer;
  10.   Strng:      Str80;
  11.   ch:         char;
  12.  
  13. procedure DisplayDev (DD: byte);
  14. begin
  15.   case DD of
  16.     $00: Strng:='No display';
  17.     $01: Strng:='MDA with 5151 monochrome';
  18.     $02: Strng:='CGA with 5153/4 color';
  19.     $04: Strng:='EGA with 5153/4 color';
  20.     $05: Strng:='EGA with 5151 monochrome';
  21.     $06: Strng:='PGC with 5175 color';
  22.     $07: Strng:='VGA with analog monochrome';
  23.     $08: Strng:='VGA with analog color';
  24.     $0B: Strng:='MCGA with analog monochrome';
  25.     $0C: Strng:='MCGA with analog color';
  26.     $03,$09..$0A,$0D..$FE: Strng:='reserved';
  27.   end; { case }
  28. end;
  29.  
  30. begin
  31.   OldVmode:=Vmode;
  32.   Qinit;
  33.   CRTcols:=CRTcolumns;
  34.   NormVideo;
  35.   Qfill (1,1,25,CRTcols,Tattr,' ');
  36.   Qwrite (1,1,-1,'Which text mode [0,1,2,3,7] ? ');
  37.   GotoRC (1,31);
  38.   readln (i);
  39.   if i in [0..3,7] then
  40.     begin
  41.       TextMode(i);
  42.       Qinit;
  43.     end;
  44.   Qfill (1,1,25,CRTcols,Tattr,' ');
  45.   case SystemID of
  46.     $FF: Strng:='IBM PC';
  47.     $FE: Strng:='IBM PC XT';
  48.     $FD: Strng:='IBM PCjr';
  49.     $FC: case SubModelID of
  50.            $00: Strng:='IBM PC AT (6 MHz)';
  51.            $01: Strng:='IBM PC AT (8 MHz)';
  52.            $02: Strng:='IBM PC XT (286)';
  53.            $04: Strng:='IBM PS/2 Model 50';
  54.            $05: Strng:='IBM PS/2 Model 60';
  55.          else   Strng:='IBM PS/2 VGA type';
  56.          end;
  57.     $FB: Strng:='IBM PC XT (256/640)';
  58.     $FA: case SubModelID of
  59.            $00: Strng:='IBM PS/2 Model 30';
  60.            $01: Strng:='IBM PS/2 Model 25';
  61.          else   Strng:='IBM PS/2 MCGA type';
  62.          end;
  63.     $F9: Strng:='IBM PC convertible';
  64.     $F8: case SubModelID of
  65.            $00: Strng:='IBM PS/2 Model 80 (16 MHz)';
  66.            $01: Strng:='IBM PS/2 Model 80 (20 MHz)';
  67.          else   Strng:='IBM PS/2 Model 70/80 type';
  68.          end;
  69.   end;  { case }
  70.   writeln ('Equip=',SystemID,' ',Strng);
  71.   writeln ('SubModel    =',SubModelID);
  72.   writeln ('PS/2 equip  =',HavePS2);
  73.   writeln ('Vmode start =',OldVmode);
  74.   writeln ('Vmode now   =',Vmode);
  75.   writeln ('Wait        =',Qwait);
  76.   writeln ('Max page #  =',MaxPage);
  77.   DisplayDev (ActiveDD);
  78.   writeln ('Active DD   =',ActiveDD,' ',Strng);
  79.   DisplayDev (AltDD);
  80.   writeln ('Alternate DD=',AltDD,' ',Strng);
  81.   writeln ('PC Conv AltD=',PCCAltDD,' (dec)');
  82.   writeln ('Cursor start=',hi(CursorMode));
  83.   writeln ('Cursor end  =',lo(CursorMode));
  84.   writeln ('CRT columns =',CRTcols);
  85.   if (ActiveDD>=EgaColor) and (ActiveDD<=VgaColor) then
  86.     begin
  87.       writeln ('EGA rows    =',EgaRows);
  88.       writeln ('EGA FontSize=',EgaFontSize);
  89.       writeln ('EGA Info    =',EgaInfo);
  90.       writeln ('EGA Switches=',EgaSwitches);
  91.     end;
  92.   writeln;
  93.   write ('Press any key...');
  94.   read (kbd,ch);
  95.   TextMode (OldVmode);
  96. end.
  97.